home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DATETIME.SWG / 0038_UNIX Date.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-09  |  9KB  |  251 lines
  1.  
  2. (***************************************************************************)
  3. (* UNIX DATE Version 1.01                                                  *)
  4. (* This unit provides access to UNIX date related functions and procedures *)
  5. (* A UNIX date is the number of seconds from January 1, 1970. This unit    *)
  6. (* may be freely used. If you modify the source code, please do not        *)
  7. (* distribute your enhancements.                                           *)
  8. (* (C) 1991-1993 by Brian Stark.                                           *)
  9. (* This is a programming release from Digital Illusions                    *)
  10. (* FidoNet 1:289/27.2 + Columbia, MO - USA                                 *)
  11. (* Revision History                                                        *)
  12. (* ----------------------------------------------------------------------- *)
  13. (* 06-13-1993 1.02 | Minor code cleanup                                    *)
  14. (* 05-23-1993 1.01 | Added a few more routines for use with ViSiON BBS     *)
  15. (* ??-??-1991 1.00 | First release                                         *)
  16. (* ----------------------------------------------------------------------- *)
  17. (***************************************************************************)
  18.  
  19. INTERFACE
  20.  
  21. Uses
  22.    DOS;
  23.  
  24. Function  GetTimeZone : ShortInt;
  25.   {Returns the value from the enviroment variable "TZ". If not found, UTC is
  26.    assumed, and a value of zero is returned}
  27. Function  IsLeapYear(Source : Word) : Boolean;
  28.   {Determines if the year is a leap year or not}
  29. Function  Norm2Unix(Y, M, D, H, Min, S : Word) : LongInt;
  30.   {Convert a normal date to its UNIX date. If environment variable "TZ" is
  31.    defined, then the input parameters are assumed to be in **LOCAL TIME**}
  32. Procedure Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word);
  33.   {Convert a UNIX date to its normal date counterpart. If the environment
  34.    variable "TZ" is defined, then the output will be in **LOCAL TIME**}
  35.  
  36. Function  TodayInUnix : LongInt;
  37.   {Gets today's date, and calls Norm2Unix}
  38. {
  39.  Following returns a string and requires the TechnoJock totSTR unit.
  40. Function  Unix2Str(N : LongInt) : String;
  41. }
  42. Const
  43.   DaysPerMonth :
  44.     Array[1..12] of ShortInt = (031,028,031,030,031,030,031,031,030,031,030,031);
  45.   DaysPerYear  :
  46.     Array[1..12] of Integer  = (031,059,090,120,151,181,212,243,273,304,334,365);
  47.   DaysPerLeapYear :
  48.     Array[1..12] of Integer  = (031,060,091,121,152,182,213,244,274,305,335,366);
  49.   SecsPerYear      : LongInt  = 31536000;
  50.   SecsPerLeapYear  : LongInt  = 31622400;
  51.   SecsPerDay       : LongInt  = 86400;
  52.   SecsPerHour      : Integer  = 3600;
  53.   SecsPerMinute    : ShortInt = 60;
  54.  
  55. IMPLEMENTATION
  56.  
  57. Function GetTimeZone : ShortInt;
  58. Var
  59.   Environment : String;
  60.   Index : Integer;
  61. Begin
  62.   GetTimeZone := 0;                            {Assume UTC}
  63.   Environment := GetEnv('TZ');       {Grab TZ string}
  64.   For Index := 1 To Length(Environment) Do
  65.     Environment[Index] := Upcase(Environment[Index]);
  66. (*
  67.   NOTE: I have yet to find a complete list of the ISO table of time zone
  68.         abbreviations. The following is excerpted from the Opus-Cbcs
  69.         documentation files.
  70. *)
  71.   If Environment =  'EST05'    Then GetTimeZone := -05; {USA EASTERN}
  72.   If Environment =  'EST05EDT' Then GetTimeZone := -06;
  73.   If Environment =  'CST06'    Then GetTimeZone := -06; {USA CENTRAL}
  74.   If Environment =  'CST06CDT' Then GetTimeZone := -07;
  75.   If Environment =  'MST07'    Then GetTimeZone := -07; {USA MOUNTAIN}
  76.   If Environment =  'MST07MDT' Then GetTimeZone := -08;
  77.   If Environment =  'PST08'    Then GetTimeZone := -08;
  78.   If Environment =  'PST08PDT' Then GetTimeZone := -09;
  79.   If Environment =  'YST09'    Then GetTimeZone := -09;
  80.   If Environment =  'AST10'    Then GetTimeZone := -10;
  81.   If Environment =  'BST11'    Then GetTimeZone := -11;
  82.   If Environment =  'CET-1'    Then GetTimeZone :=  01;
  83.   If Environment =  'CET-01'   Then GetTimeZone :=  01;
  84.   If Environment =  'EST-10'   Then GetTimeZone :=  10;
  85.   If Environment =  'WST-8'    Then GetTimeZone :=  08; {Perth, Western Austrailia}
  86.   If Environment =  'WST-08'   Then GetTimeZone :=  08;
  87. End;
  88.  
  89. Function IsLeapYear(Source : Word) : Boolean;
  90. Begin
  91. (*
  92.   NOTE: This is wrong!
  93. *)
  94.   If (Source Mod 4 = 0) Then
  95.     IsLeapYear := True
  96.   Else
  97.     IsLeapYear := False;
  98. End;
  99.  
  100. Function Norm2Unix(Y,M,D,H,Min,S : Word) : LongInt;
  101. Var
  102.   UnixDate : LongInt;
  103.   Index    : Word;
  104. Begin
  105.   UnixDate := 0;                                                 {initialize}
  106.   Inc(UnixDate,S);                                              {add seconds}
  107.   Inc(UnixDate,(SecsPerMinute * Min));                          {add minutes}
  108.   Inc(UnixDate,(SecsPerHour * H));                                {add hours}
  109.   (*************************************************************************)
  110.   (* If UTC = 0, and local time is -06 hours of UTC, then                  *)
  111.   (* UTC := UTC - (-06 * SecsPerHour)                                      *)
  112.   (* Remember that a negative # minus a negative # yields a positive value *)
  113.   (*************************************************************************)
  114.   UnixDate := UnixDate - (GetTimeZone * SecsPerHour);            {UTC offset}
  115.  
  116.   If D > 1 Then                                 {has one day already passed?}
  117.     Inc(UnixDate,(SecsPerDay * (D-1)));
  118.  
  119.   If IsLeapYear(Y) Then
  120.     DaysPerMonth[02] := 29
  121.   Else
  122.     DaysPerMonth[02] := 28;                             {Check for Feb. 29th}
  123.  
  124.   Index := 1;
  125.   If M > 1 Then For Index := 1 To (M-1) Do    {has one month already passed?}
  126.     Inc(UnixDate,(DaysPerMonth[Index] * SecsPerDay));
  127.  
  128.   While Y > 1970 Do
  129.   Begin
  130.     If IsLeapYear((Y-1)) Then
  131.       Inc(UnixDate,SecsPerLeapYear)
  132.     Else
  133.       Inc(UnixDate,SecsPerYear);
  134.     Dec(Y,1);
  135.   End;
  136.  
  137.   Norm2Unix := UnixDate;
  138. End;
  139.  
  140. Procedure Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word);
  141. {}
  142. Var
  143.   LocalDate : LongInt;
  144.   Done      : Boolean;
  145.   X         : ShortInt;
  146.   TotDays   : Integer;
  147. Begin
  148.   Y   := 1970;
  149.   M   := 1;
  150.   D   := 1;
  151.   H   := 0;
  152.   Min := 0;
  153.   S   := 0;
  154.   LocalDate := Date + (GetTimeZone * SecsPerHour);         {Local time date}
  155.  (*************************************************************************)
  156.  (* Sweep out the years...                                                *)
  157.  (*************************************************************************)
  158.   Done := False;
  159.   While Not Done Do
  160.   Begin
  161.     If LocalDate >= SecsPerYear Then
  162.     Begin
  163.       Inc(Y,1);
  164.       Dec(LocalDate,SecsPerYear);
  165.     End
  166.     Else
  167.       Done := True;
  168.  
  169.     If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) And
  170.        (Not Done) Then
  171.     Begin
  172.       Inc(Y,1);
  173.       Dec(LocalDate,SecsPerLeapYear);
  174.     End;
  175.   End;
  176.   (*************************************************************************)
  177.   M := 1;
  178.   D := 1;
  179.   Done := False;
  180.   TotDays := LocalDate Div SecsPerDay;
  181.   If IsLeapYear(Y) Then
  182.   Begin
  183.     DaysPerMonth[02] := 29;
  184.     X := 1;
  185.     Repeat
  186.       If (TotDays <= DaysPerLeapYear[x]) Then
  187.       Begin
  188.         M := X;
  189.         Done := True;
  190.         Dec(LocalDate,(TotDays * SecsPerDay));
  191.         D := DaysPerMonth[M]-(DaysPerLeapYear[M]-TotDays) + 1;
  192.       End
  193.       Else
  194.         Done := False;
  195.       Inc(X);
  196.     Until (Done) or (X > 12);
  197.   End
  198.   Else
  199.   Begin
  200.     DaysPerMonth[02] := 28;
  201.     X := 1;
  202.     Repeat
  203.       If (TotDays <= DaysPerYear[x]) Then
  204.       Begin
  205.         M := X;
  206.         Done := True;
  207.         Dec(LocalDate,(TotDays * SecsPerDay));
  208.         D := DaysPerMonth[M]-(DaysPerYear[M]-TotDays) + 1;
  209.       End
  210.       Else
  211.         Done := False;
  212.       Inc(X);
  213.     Until Done = True or (X > 12);
  214.   End;
  215.   H := LocalDate Div SecsPerHour;
  216.     Dec(LocalDate,(H * SecsPerHour));
  217.   Min := LocalDate Div SecsPerMinute;
  218.     Dec(LocalDate,(Min * SecsPerMinute));
  219.   S := LocalDate;
  220. End;
  221.  
  222. Function  TodayInUnix : LongInt;
  223. Var
  224.   Year, Month, Day, DayOfWeek: Word;
  225.   Hour, Minute, Second, Sec100: Word;
  226. Begin
  227.   GetDate(Year, Month, Day, DayOfWeek);
  228.   GetTime(Hour, Minute, Second, Sec100);
  229.   TodayInUnix := Norm2Unix(Year,Month,Day,Hour,Minute,Second);
  230. End;
  231.  
  232. Function  Unix2Str(N : LongInt) : String;
  233. Var
  234.   Year, Month, Day, DayOfWeek  : Word;
  235.   Hour, Minute, Second, Sec100 : Word;
  236.   T : String;
  237. Begin
  238.   Unix2Norm(N, Year, Month, Day, Hour, Minute, Second);
  239.   T := PadRight(IntToStr(Month),2,'0')+'-'+PadRight(IntToStr(Day),2,'0')+'-'+
  240.        PadRight(IntToStr(Year),2,'0')+' '+ PadRight(IntToStr(Hour),2,'0')+':'+
  241.        PadRight(IntToStr(Minute),2,'0')+':'+PadRight(IntToStr(Second),2,'0');
  242.   If Hour > 12 Then
  243.     T := T + ' PM'
  244.   Else
  245.     T := T + ' AM';
  246.   Unix2Str := T;
  247. End;
  248.  
  249.  
  250. END.
  251.